(FILECREATED "25-FEB-83 13:56:49" {PHYLUM}<GABRIEL>BROWSE.;16 4483   

      changes to:  (FNS INIT MATCH!)

      previous date: "25-FEB-83 13:16:29" {PHYLUM}<GABRIEL>BROWSE.;14)


(* Copyright (c) 1983 by RPG)

(PRETTYCOMPRINT BROWSECOMS)

(RPAQQ BROWSECOMS ((MACROS CHAR1)
		   (FNS INIT RANDOM SEED RANDOMIZE MATCH! BROWSE INVESTIGATE)
		   (BLOCKS
		    (BROWSEBLOCK
		     INIT RANDOM SEED RANDOMIZE MATCH! BROWSE INVESTIGATE
		     (ENTRIES BROWSE RANDOM)))
		   (GLOBALVARS RAND)
		   (INITVARS (RAND 21))))

(DECLARE: EVAL@COMPILE 

(PUTPROPS CHAR1 MACRO ((X) (NTHCHAR X 1)))
)
(DEFINEQ

(INIT
  (LAMBDA (N M NPATS IPATS)                                  (* JonL "25-FEB-83 13:54")
    (PROG ((IPATS (SUBST NIL NIL IPATS)))
          (for P on IPATS while (CDR P) finally (RPLACD P IPATS))
          (RETURN (bind (A ← NIL) for old N from N to 1 by -1 as (I ← M) by 
			(if (ZEROP I)
			    then M
			    else (SUB1 I))
		     as (NAME ←(GENSYM)) by (GENSYM)
		     do (push A NAME)
			(RPTQ I (PUTPROP NAME (GENSYM)
					 NIL))
			(PUTPROP NAME (QUOTE PATTERN)
				 (bind (A ← NIL) for I from NPATS to 1 by -1 as IPATS on IPATS
				    do (push A (CAR IPATS)) finally (RETURN A)))
			(RPTQ (DIFFERENCE M I)
			      (PUTPROP NAME (GENSYM)
				       NIL))
		     finally (RETURN A))))))

(RANDOM
  [LAMBDA NIL                                                (* edited: "25-FEB-83 13:07")
    (SETQ RAND (IMOD (ITIMES RAND 17)
		     251])

(SEED
  [LAMBDA NIL                                                (* edited: "25-FEB-83 13:07")
    (SETQ RAND 21])

(RANDOMIZE
  [LAMBDA (L)                                                (* edited: "25-FEB-83 13:11")
    (bind (A ← NIL) while L
       do [PROG [(N (IMOD (RANDOM)
			  (LENGTH L]
	        (COND
		  ((ZEROP N)
		    (push A (CAR L))
		    (SETQ L (CDR L)))
		  (T (for N from N to 2 by -1 as X on L do NIL finally (PROGN (push A (CADR X))
									      (RPLACD X (CDDR X]
       finally (RETURN A])

(MATCH!
  (LAMBDA (PAT DAT ALIST)                                    (* JonL "25-FEB-83 13:38")
    (COND
      ((NULL PAT)
	(NULL DAT))
      ((NULL DAT)
	NIL)
      ((OR (EQ (CAR PAT)
	       (QUOTE ?))
	   (EQ (CAR PAT)
	       (CAR DAT)))
	(MATCH! (CDR PAT)
		(CDR DAT)
		ALIST))
      ((EQ (CAR PAT)
	   (QUOTE *))
	(OR (MATCH! (CDR PAT)
		    DAT ALIST)
	    (MATCH! (CDR PAT)
		    (CDR DAT)
		    ALIST)
	    (MATCH! PAT (CDR DAT)
		    ALIST)))
      (T (COND
	   ((NLISTP (CAR PAT))
	     (COND
	       ((EQ (CHAR1 (CAR PAT))
		    (QUOTE ?))
		 (PROG ((VAL (FASSOC (CAR PAT)
				     ALIST)))
		       (RETURN (COND
				 (VAL (MATCH! (CONS (CDR VAL)
						    (CDR PAT))
					      DAT ALIST))
				 (T (MATCH! (CDR PAT)
					    (CDR DAT)
					    (CONS (CONS (CAR PAT)
							(CAR DAT))
						  ALIST)))))))
	       ((EQ (CHAR1 (CAR PAT))
		    (QUOTE *))
		 (PROG ((VAL (FASSOC (CAR PAT)
				     ALIST)))
		       (RETURN (COND
				 (VAL (MATCH! (APPEND (CDR VAL)
						      (CDR PAT))
					      DAT ALIST))
				 (T (for (L ← NIL) by (NCONC L (LIST (CAR D))) as E
				       on (CONS NIL DAT) as (D ← DAT) by (CDR D)
				       do (COND
					    ((MATCH! (CDR PAT)
						     D
						     (CONS (CONS (CAR PAT)
								 L)
							   ALIST))
					      (RETURN T)))))))))))
	   (T (AND (NOT (NLISTP (CAR DAT)))
		   (MATCH! (CAR PAT)
			   (CAR DAT)
			   ALIST)
		   (MATCH! (CDR PAT)
			   (CDR DAT)
			   ALIST))))))))

(BROWSE
  [LAMBDA NIL                                                (* edited: "25-FEB-83 13:14")
    (SEED)
    (INVESTIGATE [RANDOMIZE (INIT 100 10 4
				  (QUOTE ((A A A B B B B A A A A A B B A A A)
					   (A A B B B B A A (A A)
					      (B B))
					   (A A A B (B A)
					      B A B A]
		 (QUOTE ((*A ?B *B ?B A *A A *B *A)
			  (*A *B *B *A (*A)
			      (*B))
			  (? ? *(B A)* ? ?])

(INVESTIGATE
  [LAMBDA (UNITS PATS)                                       (* edited: "25-FEB-83 13:07")
    (for UNITS on UNITS do (for PATS on PATS do (for P on (GETP (CAR UNITS)
								(QUOTE PATTERN))
						   do (MATCH! (CAR PATS)
							      (CAR P)
							      NIL])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS RAND)
)

(RPAQ? RAND 21)
(PUTPROPS BROWSE COPYRIGHT ("RPG" 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (475 4335 (INIT 485 . 1319) (RANDOM 1321 . 1478) (SEED 1480 . 1604) (RANDOMIZE 1606 . 
2074) (MATCH! 2076 . 3588) (BROWSE 3590 . 4008) (INVESTIGATE 4010 . 4333)))))
STOP